home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / gwuada_9.zip / 13.C < prev    next >
C/C++ Source or Header  |  1993-07-27  |  30KB  |  1,044 lines
  1. /*
  2.  * Copyright (C) 1985-1992  New York University
  3.  * 
  4.  * This file is part of the Ada/Ed-C system.  See the Ada/Ed README file for
  5.  * warranty (none) and distribution info and also the GNU General Public
  6.  * License for more details.
  7.  
  8.  */
  9.  
  10. #ifndef SEM
  11. #define SEM    1
  12. #endif
  13.  
  14. #include "hdr.h"
  15. #include "vars.h"
  16. #include "attr.h"
  17. #include "setp.h"
  18. #include "dclmapp.h"
  19. #include "arithp.h"
  20. #include "errmsgp.h"
  21. #include "miscp.h"
  22. #include "smiscp.h"
  23. #include "chapp.h"
  24.  
  25.  
  26. /* 13. Representation Clauses*/
  27.  
  28. #define max_val(x,y)    ((x) > (y) ? (x) : (y)) 
  29.  
  30. #define rc_unset                 0    
  31. #define rc_set                    1
  32. #define rc_default                (-1)
  33.  
  34. #define storage_unit             32
  35. #define padding                  0
  36.  
  37. #define size_position            2
  38. #define storage_size_position    4
  39. #define small_position           4
  40. #define pack_position            4
  41. #define literal_map_position     4
  42. #define alignment_position       6
  43.  
  44. /*
  45.  * Currently the representation information is structured as follows:
  46.  *
  47.  * integer & floating point types
  48.  * [size]
  49.  *
  50.  * task & access types
  51.  * [size, storage_size]
  52.  *
  53.  * fixed point types
  54.  * [size] -- small is kept in the symbol table as 5th entry of signature
  55.  *
  56.  * array types
  57.  * [size, pack]
  58.  *
  59.  * record types
  60.  * [size, pack, [modulus, [[field, pos, first_bit, last_bit],...]]]
  61.  *
  62.  * enumeration types
  63.  * [size, literal_map]
  64.  *
  65.  */
  66.  
  67. static char *default_representation(Symbol, int);
  68. static void apply_length_clause(int, Symbol, Node);
  69. static void apply_enum_clause(Symbol, Tuple);
  70. static void apply_record_clause(Symbol, int, Tuple);
  71. static Tuple not_chosen_get(Symbol);
  72. static void not_chosen_delete(Symbol);
  73. static int default_size_value(Symbol);
  74. static int component_size(Symbol);
  75. static Tuple default_record_value(Symbol);
  76. extern int ADA_MAX_INTEGER;
  77.  
  78. void initialize_representation_info(Symbol type_name, int tag)
  79. /*;initialize_representation_info */
  80.  
  81. {
  82. /*
  83.  * Initialize the representation information of the given type by setting
  84.  * all its fields to the status unset. 
  85.  */
  86. Tuple    rctup;
  87. if (tag == TAG_RECORD) {
  88.    rctup = tup_new(7);
  89.    rctup[1] = (char *) tag;
  90.    rctup[2] = (char *) rc_unset;
  91.    rctup[4] = (char *) rc_unset;
  92.    rctup[6] = (char *) rc_unset;
  93. }
  94. else if (tag == TAG_TASK    || tag == TAG_ACCESS    ||
  95.          tag == TAG_ARRAY    || tag == TAG_ENUM) {
  96.    rctup = tup_new(5);
  97.    rctup[1] = (char *) tag;
  98.    rctup[2] = (char *) rc_unset;
  99.    rctup[4] = (char *) rc_unset;
  100. }
  101. else {            /*  TAG_INT  || TAG_FIXED */
  102.    rctup = tup_new(3);
  103.    rctup[1] = (char *) tag;
  104.    rctup[2] = (char *) rc_unset;
  105. }
  106. RCINFO(type_name) = rctup;
  107. FORCED(type_name) = FALSE;
  108. not_chosen_put(type_name, (Symbol)0);
  109. }
  110.  
  111. void choose_representation(Symbol type_name)
  112. /*;choose_representation(type_name)*/
  113. {
  114. Symbol    b_type;
  115. Tuple    current_rep;
  116. Tuple    tup;
  117. int        status,i,n;
  118.  
  119. b_type = base_type(type_name);
  120. current_rep = RCINFO(b_type);
  121.  
  122. if (current_rep == (Tuple)0) {
  123.    REPR(type_name) = (Tuple)0;
  124.    return;
  125. }
  126. n = tup_size(current_rep);
  127. for (i=2; i<=n; i+=2) { 
  128.    status = (int) current_rep[i];
  129.    if (status == rc_unset) {
  130.       current_rep[i] = (char *) rc_default;
  131.       current_rep[i+1] = (char *) default_representation(type_name,i);
  132.    }
  133. }
  134. tup = tup_new((n/2)+1);
  135. tup[1] = current_rep[1];
  136. for (i=1; i<=(n/2); i++) { 
  137.   tup[i+1] = current_rep[2*i+1];
  138. }
  139. REPR(type_name) = tup;
  140. }
  141.  
  142. void inherit_representation_info(Symbol derived_type, Symbol parent_type)
  143. /*; inherit_representation_info */
  144. {
  145. Symbol    b_type;
  146. Symbol    v_type;
  147. Tuple    current_rep;
  148. int        i,n;
  149.  
  150. /*
  151.  * A derived type inherits all the representation information of its parent.
  152.  * However, this information is only considered to have a status of a 'default'
  153.  * representation which may be overidden by an explicit representation clause
  154.  * given to the derived type. It is therefore necessary to change the status
  155.  * field of the derived type when the parent had the status of 'set'.
  156.  */
  157.  
  158. /*
  159.  * If the parent type is private we must retrieve its base type from the
  160.  * private_decls entry
  161.  */
  162.    if (TYPE_OF(parent_type) == symbol_private ||   
  163.        TYPE_OF(parent_type) == symbol_limited_private) {
  164.        v_type = private_decls_get((Private_declarations)
  165.                       private_decls(SCOPE_OF(parent_type)), parent_type);
  166.         /*
  167.          * Check to seem if vis_decl is defined before accessing it. It might be
  168.          * undefined in the case of compilation errors.
  169.          */
  170.          if (v_type != (Symbol)0) {
  171.              b_type = TYPE_OF(v_type);     /* TYPE_OF field in the symbol table */
  172.          }
  173.          else {
  174.            return;
  175.          }
  176.     }
  177.     else  {
  178.            b_type = base_type(parent_type);
  179.     }
  180.     current_rep = RCINFO(b_type);
  181.     if (current_rep == (Tuple)0) {
  182.         return;
  183.     }
  184.     current_rep = tup_copy((Tuple)RCINFO(b_type));
  185.     n = tup_size(current_rep);
  186.     for (i=2;i<=n;i+=2) {
  187.           if ((int)current_rep[i] == rc_set) {
  188.               current_rep[i] = (char *) rc_default;
  189.         }
  190.         else if ((int) current_rep[i] == rc_unset) {
  191.               current_rep[i] = (char *) rc_default;
  192.             current_rep[i+1] = (char *) default_representation(derived_type,i);
  193.            }
  194.      }
  195.     RCINFO(derived_type) = current_rep;
  196.     FORCED(derived_type) = FALSE;
  197.     not_chosen_put(derived_type, (Symbol)0);
  198. }
  199. already_forced(Symbol type_name)                 /*; already_forced */
  200. {
  201. int    result;
  202. result = FORCED(type_name);
  203. return result;
  204. }
  205.  
  206. void force_representation(Symbol type_name)         /*; force_representation */
  207. {
  208. Symbol     b_type,r_type,v_type,sym;
  209. Fortup    ft1;    
  210. Tuple    current_rep,tup,field_names;
  211. int        i,n;
  212.  
  213. b_type = base_type(type_name);
  214.  
  215. /* Check if type has already been forced. */
  216. if (already_forced(b_type)) {
  217.    return;
  218. }
  219. else {
  220.    if (is_generic_type(b_type)) {
  221.   /*
  222.    * There is no need to force a generic formal type since any use of this
  223.    * type will refer to the generic actual parameter after the instantiation
  224.    * and therefore the representation information is just that of the actual.
  225.    * Subtypes of generic formal types will be handled differently with the
  226.    * 'delayed_repr' instruction generated in Subtype_Declaration.
  227.    */
  228.       not_chosen_delete(b_type);
  229.       return;
  230.    }
  231. #ifdef TBSL
  232.    else if (has_generic_component(b_type)) {
  233.    /* If a type has generic components its forcing must be delayed until
  234.     * the point of instantiation when the representation of the actuals are
  235.     * known, since the representation of the record or array is dependent on
  236.     * the representation of the generic components. The replace routine will
  237.     * choose the representation for all
  238.     * delayed reprs.
  239.     */
  240.       delayed_reprs with:= b_type;
  241.       FORCED(b_type) = TRUE;
  242.       return;
  243.    }
  244. #endif
  245.    FORCED(b_type) = TRUE;
  246.    current_rep = RCINFO(b_type);
  247.    if (current_rep == (Tuple)0) {
  248.       /* some sort of error condition */
  249.       not_chosen_delete(b_type);
  250.       return;
  251.    }
  252.    n = tup_size(current_rep);
  253.    for (i=2;i<=n;i+=2) {
  254.      if ((int)current_rep[i] == rc_default) {
  255.         current_rep[i] = (char *) rc_set;
  256.      }
  257.    }
  258.    RCINFO(b_type) = current_rep;
  259.   /*
  260.    * Force all component fields of the record type before the representation is
  261.    * decided for the record type since the component types may affect the size
  262.    * of the record.
  263.    */
  264.  
  265.    if (is_record(b_type)) {
  266.       r_type = root_type(type_name);
  267.       if (TYPE_OF(r_type) == symbol_private ||
  268.           TYPE_OF(r_type) == symbol_limited_private) {
  269.           v_type = private_decls_get((Private_declarations)
  270.                          private_decls(SCOPE_OF(r_type)), r_type);
  271.           if (v_type == (Symbol)0) {         /* error condition */
  272.               not_chosen_delete(b_type);
  273.               return;
  274.           }
  275.           field_names = build_comp_names((Node) invariant_part(v_type));
  276.       }
  277.       else {
  278.           field_names = build_comp_names((Node) invariant_part(b_type));
  279.       }
  280.       FORTUP(sym=(Symbol),field_names,ft1);
  281.          force_representation(TYPE_OF(sym));
  282.       ENDFORTUP(ft1);
  283.    }
  284.    choose_representation(b_type);
  285.    tup = not_chosen_get(b_type);
  286.    FORTUP(sym=(Symbol),tup, ft1);
  287.      choose_representation(sym);
  288.    ENDFORTUP(ft1);
  289.    not_chosen_delete(b_type);
  290. }
  291. }
  292. void force_all_types()                                 /*; force_all_types */
  293. {
  294. Symbol    b_type;
  295.  
  296. /*
  297.  * Called at the end of a declarative part, to force all types not already
  298.  * affected by a forcing occurence.
  299.  */
  300.  
  301. while (tup_size(NOT_CHOSEN) > 0) {
  302.    b_type = (Symbol) NOT_CHOSEN[1];
  303.    force_representation(b_type);
  304. }
  305. }
  306. stat